home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / bix02.arc / FIB.PAS < prev    next >
Pascal/Delphi Source File  |  1986-08-04  |  4KB  |  123 lines
  1. (* Contributed to WelchNet 415-664-2811 by Neil Rubenking 2/21/86 *)
  2. (**)
  3. (* This program shows how to access the file information block. *)
  4. (**)
  5. (**)
  6.  
  7. program file_info;
  8.   (* ================================================================== *)
  9.   (*   TURBO procedures can treat logical devices as if they were text  *)
  10.   (*   files.  However, the programmer might want to do something just  *)
  11.   (*   a LITTLE different depending on which file or device comes to    *)
  12.   (*   the procedure.  The File Interface Block corresponding to the    *)
  13.   (*   file or device contains quite a bit of information which can     *)
  14.   (*   be useful in such a case.  This little program demonstrates      *)
  15.   (*   a procedure to make use of that information.                     *)
  16.   (* ================================================================== *)
  17.   (*   NOTE that the FIB information here is DOS-specific.  CP/M users  *)
  18.   (*   have similar information available, in a slightly different      *)
  19.   (*   format.                                                          *)
  20.   (* ================================================================== *)
  21. type
  22.   Flag_Set = set of (b0,b1,b2,b3,b4,Char_Waiting,Out_Okay, In_Okay);
  23.  
  24.   fancy_FIB = record               {<-- see TURBO 3.0 manual, p. 220}
  25.                 handle : integer;
  26.                 F : record
  27.                       case boolean of
  28.                         true  : (ftype : byte);
  29.                         false : (flags : flag_set);
  30.                     end;
  31.                 chBuff : byte;
  32.                 Buff_Offset,
  33.                 Buff_Size,
  34.                 Buff_Pointer,
  35.                 Buff_End : integer;
  36.                 path : array[0..63] of char;
  37.               end;
  38.      HexString = string[4];
  39. var
  40.   TextFile : text;
  41.   TextFil2 : text[$123];   {<-- specifies a file buffer of $123 bytes }
  42.   TextFil3 : text;
  43.  
  44.     FUNCTION Hex(II : Integer) : HexString;
  45.       CONST
  46.         HexDig : STRING[16] = '0123456789ABCDEF';
  47.       VAR
  48.         temp : HexString;
  49.       BEGIN
  50.         temp[0] := #4;
  51.         temp[1] := HexDig[((Hi(II) AND $FF) SHR 4)+1];
  52.         temp[2] := HexDig[((Hi(II) AND $FF) AND $F)+1];
  53.         temp[3] := HexDig[((Lo(II) AND $FF) SHR 4)+1];
  54.         temp[4] := HexDig[((Lo(II) AND $FF) AND $F)+1];
  55.         Hex := temp;
  56.       END;
  57.  
  58.  
  59.   procedure Do_File_Thing(VAR F );
  60.   var
  61.     FIB : Fancy_FIB absolute F;
  62.     N   : byte;
  63.   begin
  64.     WriteLn('REPORT on a text file or device :');
  65.     with FIB do
  66.       begin
  67.         case F.ftype and $F of
  68.           0: begin
  69.                Write('A disk file: "');
  70.                N := 0;
  71.                while (N < 63) and (path[N] <> #0) DO
  72.                  begin
  73.                    write(path[N]);
  74.                    N := N + 1;
  75.                  end;
  76.                writeLn('"');
  77.                IF (Out_Okay in F.Flags) or (In_Okay in F.Flags) THEN
  78.                  BEGIN
  79.                    WriteLn('The handle is ',handle);
  80.                    write('BUFFER starts at ',hex(Buff_Offset));
  81.                    write(', ends at ',hex(buff_end));
  82.                    write(', size is ',hex(buff_size));
  83.                    writeLn(' and current pointer is ',hex(buff_pointer));
  84.                    IF Char_Waiting in F.Flags THEN
  85.                      writeLn('CHAR waiting is ',chBuff)
  86.                    ELSE writeLn('NO char waiting');
  87.                  END
  88.                ELSE
  89.                  WriteLn('The file is not yet open.');
  90.              end;
  91.           1: writeLn('CON: device');
  92.           2: writeLn('KBD: device');
  93.           3: writeLn('LST: device');
  94.           4: writeLn('AUX: device');
  95.           5: writeLn('USR: device');
  96.         end;
  97.         IF Out_Okay in F.flags THEN writeLn('Open for output.');
  98.         IF IN_Okay in F.flags THEN writeLn('Open for input.');
  99.       end;
  100.     writeLn;
  101.   end;
  102.  
  103. begin
  104.   assign(TextFile,'FilDat.pas');
  105.   Do_File_Thing(TextFile);
  106.   reset(TextFile);
  107.   Do_File_Thing(TextFile);
  108.   assign(TextFil2,'FilDat.pas');
  109.   reset(TextFil2);
  110.   Do_File_Thing(TextFil2);
  111.   WriteLn('Press a key to continue . . .');
  112.   repeat until keypressed; read(Kbd);
  113.   assign(TextFil3,'SomeDumb.fil');
  114.   rewrite(TextFil3);
  115.   Do_File_Thing(TextFil3);
  116.   close(TextFile);
  117.   close(TextFil2);
  118.   close(TextFil3);
  119.   Do_File_Thing(Lst);
  120.   Do_File_Thing(Kbd);
  121.   Do_File_Thing(output);
  122. end.
  123.